the 1st

The first ugly attempt…

I created my first dropdown in 2020 & … looking back, I remember it being quite ugly. It was largely my first experience with html, javascript, and css so my end rmarkdown output looked something like the below

# section
<div>
<select id='countrySelector'>
<option val="cleanVal"> Manually defined option one </option>
<option val="...">...</option>
.
.
.
</select>
\\```{r}

data %>% 
  split(.$id) %>% 
  imap(~{
   create_plot() %>% 
   div(id = glue::glue("{.y}CountryOpt"),class="CountryOpt")
  })


\\```
<script>
var selector = document.getElementById("countrySelector")
selector.onchange = function(){
  // logic to hide all of the .CountryOpt charts
  // logic to find the id of the selected chart
  // set the display to show the selected chart
}

</script>

</div>

the second

An improved 2nd attempt

considerations / drawbacks

Speed / render / redraw

third attempt

Simplifying and finally cracking

# https://github.com/zac-garland/highchart.extensions/blob/master/R/add_multi_drop.R
add_multi_drop <- function(hc, selectors, selected = NULL) {
  # first we create a random id to ensure that if used multiple times, each selector / chart combo has a unique id
  rand_id_begin <- paste(sample(letters, 3, replace = FALSE),
    sample(letters, 4, replace = FALSE),
    sample(letters, 3, replace = FALSE),
    collapse = ""
  ) |> stringr::str_remove_all(" ")

  # next we generate the potential list options available in the chart (to ensure that we aren't passing in multiple data sets or trying to attach the data again to the web document)
  list_opts <- purrr::map(setNames(selectors, selectors), ~ {
    select_name <- .x
    hc$x$hc_opts$series |>
      purrr::map(~ {
        purrr::map(purrr::pluck(.x, "data"), ~ {
          purrr::pluck(.x, select_name)
        }) |>
          unlist()
      }) |>
      unlist() |>
      unique()
  })

  # generate the select html input elements with their corresponding options
  select_options <- list_opts |>
    purrr::imap(~ {
      htmltools::tags$select(
        style = "display:inline-block",
        id = paste0(.y, rand_id_begin),
        purrr::map(.x, ~ {
          if ((!is.null(selected) & .x %in% selected)) {
            htmltools::tags$option(value = ., ., `selected` = TRUE)
          } else {
            htmltools::tags$option(value = ., .)
          }
        })
      )
    })

  # generate variable declaration statement in javascript using R string interpolation (comparable to es7 `this var: ${var}`)
  names(list_opts) |>
    purrr::map_chr(~ {
      glue::glue("var select_{paste0(.x, rand_id_begin)} = document.getElementById('{paste0(.x, rand_id_begin)}');")
    }) |>
    paste(collapse = "") -> var_declaration

  # generate shared javascript filter (each chart should be aware of multiple inputs - and share the filter between onchange events)
  names(list_opts) |>
    purrr::map_chr(~ {
      glue::glue("obj.{.x} == select_{paste0(.x, rand_id_begin)}.value")
    }) |>
    paste(collapse = " & ") -> filter_declaration

  # generate the onchange events to monitor each of the inputs
  names(list_opts) |>
    purrr::map_chr(~ {
      glue::glue("select_{paste0(.x, rand_id_begin)}.onchange = updateChart;")
    }) |>
    paste(collapse = "") -> onchg_events

# create the javascript function for highcharts events, adding in the variable declaration, filters, and events generated from previous steps
  
js_fun <- "function(){{
  var this_chart = this;
  // create a cloned data set (to avoid highcharts mutate behavior)
  const cloneData = (sample) => {{ return JSON.parse(JSON.stringify(sample));}}
  // initialize empty array 
  const init_data = [];
  // loop over chart series and add to data array
  this_chart.options.series.map((series,index)=>{{
    init_data[index] = cloneData(series.data);
  }})

  // declare variables
  {var_declaration}

  // create shared updateChart function
  function updateChart(){{
      // map the series data to filter based on inputs
      init_data.map((series,index)=>{{
      new_data = series.filter(function(obj){{
        return {filter_declaration}
        }});
      // only draw if data is available post filter
      if(new_data.length>0){{
        this_chart.series[index].setData(new_data);
      }}

      }})
    // redraw chart
    this_chart.reflow();

  }}
  // add on change monitor events for dropdowns
  {onchg_events}
  // updateChart (for first run)
  updateChart();
}}"

# add javascript function as an onload event (so we filter down the data in the first view)
  highcharter::hc_chart(hc,
    events = list(
      load = highcharter::JS(glue::glue(js_fun))
    )
  ) |>
    htmltools::tagList(
      select_options, . # create a html fragment including the dropdowns and chart 
    ) |>
    htmltools::browsable() # create a browsable option (shows chart in rstudio or in render)
}

tidy_employment_data <- fpp3::us_employment |>
  janitor::clean_names() |>
  as_tibble() |>
  filter(!str_detect(title,":")) |>
  rename(value = employed) |>
  mutate(month = lubridate::as_date(month)) |>
  group_by(title) |>
  mutate(yoy = value/lag(value,12)-1,
         `Three year comp` = value/lag(value,36)-1) |>
  gather(key,value,value:`Three year comp`) 

tidy_employment_data |>
  mutate(month = datetime_to_timestamp(month)) |> # for highcharts date format
  highcharter::hchart("line", highcharter::hcaes(month, value, name = title)) |>
  hc_xAxis(type = "datetime") |>
  add_multi_drop(
    selectors = c("title", "key"),
    selected = c("Total Private", "Three year comp")
  )